home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
btv115.zip
/
BTRV6.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-02-23
|
9KB
|
216 lines
UNIT BTRV6;
{****************************************************************************}
{* REVISION HISTORY *}
{* *}
{* Date Who What *}
{* ======================================================================== *}
{* 02/01/92 RWH Changed all instances of Data Buffer Length from Integer *}
{* to Word so variable length records can be up to 64K. *}
{****************************************************************************}
INTERFACE
{$R-} {Range checking off}
{$B+} {Boolean complete evaluation on}
{$S+} {Stack checking on}
{$N-} {No numeric coprocessor}
{+--------------------------------------------------------------------------+}
{ }
{ Module Name: BTRV6.PAS }
{ }
{ Description: This is the Btrieve interface for Turbo Pascal 6.0 (MS-DOS). }
{ This routine sets up the parameter block expected by }
{ Btrieve, and issues interrupt 7B. It should be compiled }
{ with the $V- switch so that runtime checks will not be }
{ performed on the variable parameters. }
{ }
{ Synopsis: STAT := BTRV (OP, POS.START, DATA.START, DATALEN, }
{ KBUF.START, KEY); }
{ where }
{ OP is an integer, }
{ POS is a 128 byte array, }
{ DATA is an untyped parameter for the data buffer, }
{ DATALEN is the integer length of the data buffer, }
{ KBUF is the untyped parameter for the key buffer, }
{ and KEY is an integer. }
{ }
{ Returns: Btrieve status code (see Appendix B of the Btrieve Manual). }
{ }
{ Note: The Btrieve manual states that the 2nd, 3rd, and 5th }
{ parameters be declared as variant records, with an integer }
{ type as one of the variants (used only for Btrieve calls), }
{ as is shown in the example below. This is supported, but }
{ the restriction is no longer necessary. In other words, any }
{ variable can be sent in those spots as long as the variable }
{ uses the correct amount of memory so Btrieve does not }
{ overwrite other variables. }
{ }
{ var DATA = record case boolean of }
{ FALSE: ( START: integer ); }
{ TRUE: ( EMPLOYEE_ID: 0..99999; }
{ EMPLOYEE_NAME: packed array[1..50] of char; }
{ SALARY: real; }
{ DATA_OF_HIRE: DATE_TYPE ); }
{ end; }
{ }
{ There should NEVER be any string variables declared in the }
{ data or key records, because strings store an extra byte for }
{ the length, which affects the total size of the record. }
{ }
{ }
{+--------------------------------------------------------------------------+}
USES
Dos;
CONST
BTR_INT : Byte = $7B;
Function BTRV( OP : Integer;
var POS,
DATA;
var DATALEN : Word;
var KBUF;
KEY : Integer
): Integer;
{============================================================================}
IMPLEMENTATION
Function BTRV( OP : Integer;
var POS,
DATA;
var DATALEN : Word;
var KBUF;
KEY : Integer
): Integer;
const
VAR_ID = $6176; {id for variable length records - 'va'}
BTR2_INT = $2F;
BTR_OFFSET = $0033;
MULTI_FUNCTION = $AB;
{ ProcId is used for communicating with the Multi Tasking Version of }
{ Btrieve. It contains the process id returned from BMulti and should }
{ not be changed once it has been set. }
{ }
ProcId : integer = 0; { initialize to no process id }
MULTI : boolean = false; { set to true if BMulti is loaded }
VSet : boolean = false; { set to true if we have checked for BMulti }
type
ADDR32 = record {32 bit address}
OFFSET : integer;
SEGMENT: integer;
end;
BTR_PARMS = record
USER_BUF_ADDR : ADDR32; {data buffer address}
USER_BUF_LEN : Word; {data buffer length}
USER_CUR_ADDR : ADDR32; {currency block address}
USER_FCB_ADDR : ADDR32; {file control block address}
USER_FUNCTION : integer; {Btrieve operation}
USER_KEY_ADDR : ADDR32; {key buffer address}
USER_KEY_LENGTH: BYTE; {key buffer length}
USER_KEY_NUMBER: BYTE; {key number}
USER_STAT_ADDR : ADDR32; {return status address}
XFACE_ID : integer; {language interface id}
end;
var
STAT : integer; {Btrieve status code}
XDATA: BTR_PARMS; {Btrieve parameter block}
REGS : Dos.Registers; {register structure used on interrrupt call}
DONE : boolean;
begin
REGS.AX := $3500 + BTR_INT;
INTR ($21, REGS);
if (REGS.BX <> BTR_OFFSET) then {make sure Btrieve is installed}
STAT := 20
else
begin
if (not VSet) then {if we haven't checked for Multi-User version}
begin
REGS.AX := $3000;
INTR ($21, REGS);
if ((REGS.AX AND $00FF) >= 3) then
begin
VSet := true;
REGS.AX := MULTI_FUNCTION * 256;
INTR (BTR2_INT, REGS);
MULTI := ((REGS.AX AND $00FF) = $004D);
end
else
MULTI := false;
end;
{make normal btrieve call}
with XDATA do
begin
USER_BUF_ADDR.SEGMENT := SEG (DATA);
USER_BUF_ADDR.OFFSET := OFS (DATA); {set data buffer address}
USER_BUF_LEN := DATALEN;
USER_FCB_ADDR.SEGMENT := SEG (POS);
USER_FCB_ADDR.OFFSET := OFS (POS); {set FCB address}
USER_CUR_ADDR.SEGMENT := USER_FCB_ADDR.SEGMENT; {set cur seg}
USER_CUR_ADDR.OFFSET := USER_FCB_ADDR.OFFSET+38;{set cur ofs}
USER_FUNCTION := OP; {set Btrieve operation code}
USER_KEY_ADDR.SEGMENT := SEG (KBUF);
USER_KEY_ADDR.OFFSET := OFS (KBUF); {set key buffer address}
USER_KEY_LENGTH := 255; {assume its large enough}
USER_KEY_NUMBER := KEY; {set key number}
USER_STAT_ADDR.SEGMENT := SEG (STAT);
USER_STAT_ADDR.OFFSET := OFS (STAT); {set status address}
XFACE_ID := VAR_ID; {set lamguage id}
end;
REGS.DX := OFS (XDATA);
REGS.DS := SEG (XDATA);
if (NOT MULTI) then {MultiUser version not installed}
INTR (BTR_INT, REGS)
else
begin
DONE := FALSE;
repeat
REGS.BX := ProcId;
REGS.AX := 1;
if (REGS.BX <> 0) then
REGS.AX := 2;
REGS.AX := REGS.AX + (MULTI_FUNCTION * 256);
INTR (BTR2_INT, REGS);
if ((REGS.AX AND $00FF) = 0) then
DONE := TRUE
else
begin
REGS.AX := $0200;
INTR ($7F, REGS);
DONE := FALSE;
end;
until (DONE);
if (ProcId = 0) then
ProcId := REGS.BX;
end;
DATALEN := XDATA.USER_BUF_LEN;
end;
BTRV := STAT;
end;
End.